home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / Modes / htmlCustom.tcl < prev    next >
Text File  |  1996-08-15  |  38KB  |  1,064 lines
  1. #=============================================================================
  2. #
  3. #    htmlCustom.tcl
  4. #
  5. #    Part of HTML mode 1.2
  6. #
  7. #    HTML custom elements.
  8. #
  9. #    Author: Johan Linde <jl@theophys.kth.se>
  10. #
  11. #    If you make improvements to this file, please share them!
  12. #
  13. #=============================================================================
  14.  
  15. #
  16. # Defining new HTML elements.
  17. #
  18. proc htmlCustomNewElem {} {
  19.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr htmlElemAttrUsed
  20.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  21.     global htmlElemEventHandler1 htmlElemProc htmlElemKeyBinding htmlPlugins htmlElemAttrMore
  22.     global HTMLmodeVars specURL specColor specWindow htmlSpecURL htmlSpecColor htmlSpecWindow
  23.     global htmlVersion
  24.     
  25.     set invalidInput 1
  26.     set values {"" 1 1 0 0 "" 0 0 0 0}
  27.     while {$invalidInput} {
  28.         set box "-t {New element} 10 10 100 25 -e [list [lindex $values 0]] 110 10 250 25 ¥
  29.         -c {Has closing tag} [lindex $values 1] 10 40 150 55 ¥
  30.         -t {Element type} 10 80 100 95 -r Normal [lindex $values 2] 10 100 100 115 ¥
  31.         -r {INPUT element with TYPE given above} [lindex $values 3] 10 120 300 135 ¥
  32.         -r {Plug-in} [lindex $values 4] 10 140 100 155 ¥
  33.         -t {Key binding} 10 180 90 195 -e [list [lindex $values 5]] 100 180 120 195 ¥
  34.         -c Shift [lindex $values 6] 10 210 60 225 ¥
  35.         -c Control [lindex $values 7] 80 210 150 225 ¥
  36.         -c Option [lindex $values 8] 160 210 220 225 ¥
  37.         -c Command [lindex $values 9] 230 210 320 225 ¥
  38.         -b OK 20 240 85 260 -b Cancel 105 240 170 260"
  39.         set values [eval [concat dialog -w 340 -h 270 $box]]
  40.         if {[lindex $values 11]} {return}
  41.         set element [string toupper [string trim [lindex $values 0]]]
  42.         set closingTag [lindex $values 1]
  43.         if {[lindex $values 2]} {
  44.             set elemType normal
  45.         } elseif {[lindex $values 3]} {
  46.             set elemType input
  47.         } else {
  48.             set elemType plugin
  49.         }
  50.         set elemKey [string toupper [string trim [lindex $values 5]]]
  51.         set keyStr ""
  52.         if {[lindex $values 6]} {append keyStr "<U"}
  53.         if {[lindex $values 7]} {append keyStr "<B"}
  54.         if {[lindex $values 8]} {append keyStr "<I"}
  55.         if {[lindex $values 9]} {append keyStr "<O"}
  56.         
  57.         # Check that input is ok.
  58.         if {![string length $element]} {
  59.             alertnote "You must specify the element."
  60.         } elseif {[info exists htmlElemAttrOptional1($element)]} {
  61.             alertnote "The element $element is already defined."
  62.             return
  63.         } elseif {![regexp {^[_a-zA-Z0-9]+$} $element]} {
  64.             alertnote "Invalid characters in element name. For example, it may not contain spaces."
  65.         } elseif {[string length $elemKey] > 1} {
  66.             alertnote "You should only give one character for key binding."
  67.         } elseif {[string length $elemKey] && ($keyStr == "" || $keyStr == "<U")} {
  68.             alertnote "You must choose at least one of the modifiers control, option and command when you define a key binding."
  69.         } else {
  70.             set invalidInput 0
  71.         }
  72.     }
  73.     if {![string length $elemKey]} {
  74.         set keyStr ""
  75.     } else {
  76.         set elemKey "/$elemKey"
  77.     }    
  78.     
  79.     # Get the attributes    
  80.     set allattributes [htmlGetCustomAttrs $element {}]
  81.     if {![string length $allattributes]} {return}
  82.     set optional [lindex $allattributes 0]
  83.     set AttrRequired [lindex $allattributes 1]
  84.     set AttrNumber [lindex $allattributes 2]
  85.     set AttrChoices [lindex $allattributes 3]
  86.     set EventHandler [lindex $allattributes 4]
  87.     set URL [lindex $allattributes 5]
  88.     set Color [lindex $allattributes 6]
  89.     set Window [lindex $allattributes 7]
  90.     # Get the layout.
  91.     if {$elemType != "normal" || !$closingTag} {
  92.         set customproc [htmlSetCustProc1 {0 0} $elemType $element]
  93.     } else {
  94.         set customproc [htmlSetCustProc2 {1 0 0 0} $element]
  95.     }
  96.     if {![string length $customproc]} {return}
  97.     
  98.     # Save the element
  99.     message "Saving new elementﾉ"
  100.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  101.     set fid [open $PREFS:HTMLadditions.tcl a+]
  102.     if {!$isfile} {puts $fid $htmlVersion}
  103.     puts $fid "$element ¥{set htmlElemKeyBinding($element) [list $keyStr$elemKey]¥}"
  104.     set htmlElemKeyBinding($element) $keyStr$elemKey
  105.     puts $fid "$element ¥{set htmlElemProc($element) [list $customproc]¥}"
  106.     set htmlElemProc($element) $customproc
  107.     foreach rcne [list AttrRequired AttrChoices AttrNumber EventHandler] {
  108.         if {[llength [set $rcne]]} {
  109.             puts $fid "$element ¥{set htmlElem${rcne}1($element) [list [set $rcne]]¥}"
  110.             set htmlElem${rcne}1($element) [set $rcne]
  111.         }
  112.     }
  113.     # Remove possible old versions of htmlElemAttrUsed and htmlElemAttrMore
  114.     if {[info exists htmlElemAttrUsed($element)]} {
  115.         unset htmlElemAttrUsed($element)
  116.         removeArrDef htmlElemAttrUsed $element
  117.     }
  118.     if {[info exists htmlElemAttrMore($element)]} {
  119.         unset htmlElemAttrMore($element)
  120.         removeArrDef htmlElemAttrMore $element
  121.     }
  122.     
  123.     puts $fid "$element ¥{set htmlElemAttrOptional1($element) [list $optional]¥}"
  124.     set htmlElemAttrOptional1($element) $optional
  125.     foreach ucw [list URL Color Window] {
  126.         if {[llength [set $ucw]]} {
  127.             foreach a [set $ucw] {
  128.                 puts $fid "$element ¥{lappend html${ucw}Attr $a¥}"
  129.                 lappend html${ucw}Attr $a
  130.             }
  131.         }
  132.     }
  133.     if {$elemType == "plugin"} {
  134.         puts $fid "$element ¥{lappend htmlPlugins $element¥}"
  135.         lappend htmlPlugins $element
  136.     }
  137.     foreach ucw [list URL Color Window] {
  138.         if {[llength [set spec$ucw]]} {
  139.             puts $fid "$element ¥{lappend htmlSpec$ucw [set spec$ucw]¥}"
  140.             append htmlSpec$ucw " " [set spec$ucw]
  141.         }
  142.     }
  143.     close $fid
  144.     
  145.     message "Inserting new element in menuﾉ"
  146.     htmlBuildMenu
  147.     if {$HTMLmodeVars(JavaScriptColoring)} {
  148.         regModeKeywords -a -k $HTMLmodeVars(tagColor) ¥
  149.         HTML [concat "<$element" "/$element" $AttrRequired $optional]    
  150.     }
  151.     message "Done."
  152.     if {!$HTMLmodeVars(useBigWindows) && [llength $optional]} {htmlUseAttrs $element}
  153.     unset specURL
  154.     unset specColor
  155.     unset specWindow
  156. }
  157.  
  158. # Returns a list of all attributes used in any HTML element.
  159. proc htmlGetAllAttrs {} {
  160.     global htmlElemAttrOptional1 htmlElemAttrRequired1
  161.     
  162.     set allHTMLelems [array names htmlElemAttrOptional1]
  163.     set allHTMLattrs ""
  164.     foreach elem $allHTMLelems {
  165.         if {[info exists htmlElemAttrRequired1($elem)]} {
  166.             foreach a $htmlElemAttrRequired1($elem) {
  167.                 lappend allHTMLattrs $a
  168.             }
  169.         }    
  170.         foreach a $htmlElemAttrOptional1($elem) {
  171.             lappend allHTMLattrs $a
  172.         }
  173.     }
  174.     return $allHTMLattrs
  175. }
  176.  
  177. # Get attributes to custom element.
  178. proc htmlGetCustomAttrs {element allattrs {nomore 1}} {
  179.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  180.     global specURL specColor specWindow
  181.     
  182.     set allHTMLattrs [htmlGetAllAttrs]
  183.     set optional {}
  184.     set AttrRequired {}
  185.     set AttrChoices {}
  186.     set AttrNumber {}
  187.     set EventHandler {}
  188.     set URL {}
  189.     set Color {}
  190.     set Window {}
  191.     set specURL {}
  192.     set specColor {}
  193.     set specWindow {}
  194.     set i 0
  195.     set dispAttr $allattrs
  196.     
  197.     while {1} {
  198.         incr i
  199.         if {[catch {htmlCustomInpAttr $element $i $dispAttr $nomore} attribute]} {
  200.             if {$attribute != "Remove last!"} {return}
  201.             set toremove [lindex $dispAttr [expr [llength $dispAttr] - 1]]
  202.             set dispAttr [lreplace $dispAttr [expr [llength $dispAttr] - 1] [expr [llength $dispAttr] - 1]]
  203.             set allattrs [lreplace $allattrs [expr [llength $allattrs] - 1] [expr [llength $allattrs] - 1]]
  204.             set elemrm [lindex $toremove 0]
  205.             if {[lindex $toremove 1] == "(Flag)"} {
  206.                 if {[set ind [lsearch -exact $AttrRequired $elemrm]] >=0} {
  207.                     set AttrRequired [lreplace $AttrRequired $ind $ind]
  208.                 } elseif {[set ind [lsearch -exact $optional $elemrm]] >=0} {
  209.                     set optional [lreplace $optional $ind $ind]
  210.                 }
  211.             } else {
  212.                 foreach l [list optional AttrRequired AttrChoices AttrNumber EventHandler URL Color Window] {
  213.                     set tmp {}
  214.                     foreach m [set $l] {
  215.                         if {![string match "${elemrm}=*" $m]} {
  216.                             lappend tmp $m
  217.                         }
  218.                     }
  219.                     set $l $tmp
  220.                 }
  221.             }
  222.             foreach l [list URL Color Window] {
  223.                 if {[set where [lsearch -exact [set spec$l] "${element}=[string trimright $elemrm =]"]] >= 0 || ¥
  224.                 [set where [lsearch -exact [set spec$l] "${element}!=[string trimright $elemrm =]"]] >= 0} {
  225.                     set spec$l [lreplace [set spec$l] $where $where]
  226.                 }
  227.             }
  228.             incr i -2
  229.             continue
  230.         }
  231.         if {![string length $attribute]} {break}
  232.         if {[lsearch -exact [string toupper $allattrs] [string toupper [lindex $attribute 0]]] >= 0} {
  233.             alertnote "$element already has an attribute '[lindex $attribute 0]'."
  234.             incr i -1
  235.         } else {
  236.             if {[catch {htmlCustomAttrFix $element [lindex $attribute 0] ¥
  237.             [lindex $attribute 1] $allHTMLattrs} thisattr]} {
  238.                 incr i -1 
  239.                 continue
  240.             }
  241.             lappend allattrs [string trimright [lindex $thisattr 0] =]
  242.             set attr [lindex $thisattr 0]
  243.             set thistype [lindex $thisattr 1]
  244.             if {[lindex $attribute 2]} {
  245.                 lappend AttrRequired $attr
  246.             } elseif {$thistype != "Event handler"} {
  247.                 lappend optional $attr
  248.             } else {
  249.                 lappend EventHandler $attr
  250.             }
  251.             if {$thistype == "Choices"} {
  252.                 foreach c [lindex $thisattr 2] {
  253.                     lappend AttrChoices "$attr$c"
  254.                 }
  255.             } elseif {$thistype == "Number"} {
  256.                 lappend AttrNumber "$attr[lindex $thisattr 2]"
  257.             } elseif {$thistype == "URL" && [lsearch -exact $htmlURLAttr $attr] < 0 && [lsearch -exact $allHTMLattrs $attr] < 0} {
  258.                 lappend URL $attr
  259.             } elseif {$thistype == "Color" && [lsearch -exact $htmlColorAttr $attr] < 0 && [lsearch -exact $allHTMLattrs $attr] < 0} {
  260.                 lappend Color $attr
  261.             } elseif {$thistype == "Window" && [lsearch -exact $htmlWindowAttr $attr] < 0 && [lsearch -exact $allHTMLattrs $attr] < 0} {
  262.                 lappend Window $attr
  263.             }
  264.             lappend dispAttr "[string trimright $attr =] (${thistype})"
  265.         }
  266.     }
  267.     return [list $optional $AttrRequired $AttrNumber $AttrChoices $EventHandler $URL $Color $Window]
  268. }
  269.  
  270. # Dialog for giving a new attribute.
  271. proc htmlCustomInpAttr {element num allattrs nomore} {
  272.     set typeList [list Other Number Choices Flag URL Color Window {Event handler}]
  273.     set values {0 0 {} Other 0}
  274.     set invalidInput 1
  275.     while {$invalidInput} {
  276.         set box "-t {Attribute $num for $element} 10 10 330 25 ¥
  277.         -e [list [lindex $values 2]] 10 40 150 55 ¥
  278.         -t Type: 170 40 205 55 ¥
  279.         -m [list [concat [list [lindex $values 3]] $typeList]] ¥
  280.         210 40 330 55 -c Required [lindex $values 4] 10 70 130 85"
  281.          if {$num > 1} {append box " -b {Remove last} 340 100 450 120"}
  282.          if {$nomore || $num > 1} {append box " -b {No more attributes} 340 70 480 90"}
  283.         set wi 10
  284.         set ht 120
  285.         if {[llength $allattrs]} {
  286.             append box " -t {All attributes} 10 100 200 115"
  287.             foreach ch $allattrs {
  288.                 append box " -t [list $ch] $wi $ht [expr $wi + 195] [expr $ht + 15]"
  289.                 incr wi 200
  290.                 if {$wi == 410} {
  291.                     set wi 10
  292.                     incr ht 20
  293.                 }
  294.             }
  295.         }
  296.         if {$wi == 210} {incr ht 20}
  297.         if {$ht < 130} {set ht 130}
  298.         set values [eval [concat dialog -w 490 -h $ht ¥
  299.         -b OK 340 10 405 30 -b Cancel 340 40 405 60 $box]]
  300.         if {[lindex $values 1]} {
  301.             error "Cancel"
  302.         } elseif {$num > 1 && [lindex $values 5]} {
  303.             error "Remove last!"
  304.         } elseif {[lindex $values 0]} {
  305.             set thisattr [string trim [lindex $values 2]]
  306.             set thistype [lindex $values 3]
  307.             if {$thistype != "Event handler"} {set thisattr [string toupper $thisattr]}
  308.             set required [lindex $values 4]
  309.             if {![regexp {^[_a-zA-Z0-9]*$} $thisattr]} {
  310.                 alertnote "Invalid characters in attribute. For example, it may not contain spaces."
  311.             } elseif {[string length $thisattr]} {
  312.                 if {$required && $thistype == "Event handler"} {
  313.                     alertnote "Event handlers cannot be required attributes. It will be optional."
  314.                     set required 0
  315.                 }
  316.                 set invalidInput 0
  317.             }
  318.         } else {
  319.             return
  320.         }
  321.     }
  322.  
  323.     return [list $thisattr $thistype $required]
  324. }
  325.  
  326. # Dialogs to give more info about new attributes.
  327. proc htmlCustomAttrFix {element attr type allHTMLattrs {allchoices ""}} {
  328.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  329.     global specURL specColor specWindow
  330.  
  331.     # Check for special case with URL etc. if not called from htmlCustomNewChoice 
  332.     # (then allchoices has length >0)
  333.     foreach ucw [list URL Color Window] {
  334.         if {[lsearch -exact [set html${ucw}Attr] "$attr="] >= 0 && $type != $ucw && ![llength $allchoices]} {
  335.             lappend spec$ucw "$element!=$attr"
  336.         }
  337.     }
  338.     
  339.     switch $type {
  340.         Other {return [list "$attr=" $type]}
  341.         Number {
  342.             set values {0 0 0 {} 0}
  343.             while {1} {
  344.                 set box "-t {Range for $attr} 60 10 290 25 -t {Minvalue:} 10 40 100 55 ¥
  345.                 -e [list [lindex $values 2]] 110 40 130 55 -t {Maxvalue:} 150 40 240 55 ¥
  346.                 -e [list [lindex $values 3]] 250 40 270 55 -c {Value may be given in percent} ¥
  347.                 [lindex $values 4] 10 65 250 80"
  348.                 set values [eval [concat dialog -w 300 -h 120 ¥
  349.                 -b OK 20 90 85 110 -b Cancel 105 90 170 110 $box]]
  350.                 set min [string trim [lindex $values 2]]
  351.                 set max [string trim [lindex $values 3]]
  352.                 set percent [lindex $values 4]
  353.                 if {[lindex $values 1]} {
  354.                     error "Cancel"
  355.                 } elseif {[lindex $values 0]} {
  356.                     if {![htmlIsInteger $min]} {
  357.                         alertnote "A minimum value must be specified."
  358.                     } elseif {[string length $max] && ![htmlIsInteger $max]} {
  359.                         alertnote "Not a valid number for maximum value."
  360.                     } elseif {[string length $max] && $max < $min} {
  361.                         alertnote "Maxvalue is smaller than minvalue."
  362.                     } else {
  363.                         break
  364.                     }
  365.                 }
  366.             }
  367.             set number "$min:"
  368.             if {[string length $max]} {
  369.                 append number "$max:"
  370.             } else {
  371.                 append number "i:"
  372.             }
  373.             if {$percent} {
  374.                 append number "%"
  375.             } else {
  376.                 append number "n"
  377.             }
  378.             return [list "$attr=" $type $number]
  379.         }
  380.         Choices {
  381.             set i 0
  382.             set choices {}
  383.             while {1} {
  384.                 incr i
  385.                 set values {0 0 {}}
  386.                 set invalidInput 1
  387.                 while {$invalidInput} {
  388.                     set box "-t {Choice $i for $attr} 10 10 210 25 ¥
  389.                     -e [list [lindex $values 2]] 10 40 200 55"
  390.                     if {$i > 1} {append box " -b {No more choices} 220 70 340 90 -b {Remove last} 220 100 340 120"}
  391.                     set wi 10
  392.                     set ht 90
  393.                     if {[llength $allchoices]} {
  394.                         append box " -t {All choices} 10 70 200 85"
  395.                         foreach ch $allchoices {
  396.                             append box " -t $ch $wi $ht [expr $wi + 95] [expr $ht + 15]"
  397.                             incr wi 100
  398.                             if {$wi == 210} {
  399.                                 set wi 10
  400.                                 incr ht 20
  401.                             }
  402.                         }
  403.                     }
  404.                     if {$wi == 110} {incr ht 20}
  405.                     if {$ht < 130} {set ht 130}
  406.                     set values [eval [concat dialog -w 350 -h $ht ¥
  407.                     -b OK 220 10 285 30 -b Cancel 220 40 285 60 ¥
  408.                     $box]]
  409.                     if {[lindex $values 1]} {
  410.                         error "Cancel"
  411.                     } elseif {$i > 1 && [lindex $values 3] } {
  412.                         return [list "$attr=" $type $choices]
  413.                     } elseif {$i > 1 && [lindex $values 4]} {
  414.                         incr i -1
  415.                         set choices [lreplace $choices [expr [llength $choices] - 1] [expr [llength $choices] - 1]]
  416.                         set allchoices [lreplace $allchoices [expr [llength $allchoices] - 1] [expr [llength $allchoices] - 1]]
  417.                     } elseif {[lindex $values 0]} {
  418.                         set thischoice [string toupper [string trim [lindex $values 2]]]
  419.                         if {![regexp {^[_a-zA-Z0-9]*$} $thischoice]} {
  420.                             alertnote "Invalid characters in choice.  For example, it may not contain spaces."
  421.                         } elseif {[string length $thischoice]} {
  422.                             if {[lsearch -exact $allchoices $thischoice] >=0 } {
  423.                                 alertnote "$attr already has a choice '$thischoice'."
  424.                             } else {
  425.                                 set invalidInput 0
  426.                             }
  427.                         }
  428.                     }
  429.                 }
  430.                 lappend choices $thischoice
  431.                 lappend allchoices $thischoice
  432.             }
  433.         }
  434.         Flag {return [list $attr $type]}
  435.         URL {
  436.             if {[lsearch -exact $htmlURLAttr "$attr="] < 0 && [lsearch -exact $allHTMLattrs "$attr="] >= 0} {
  437.                 lappend specURL "${element}=$attr"
  438.             }
  439.             return [list "$attr=" $type]
  440.         }
  441.         Color {
  442.             if {[lsearch -exact $htmlColorAttr "$attr="] < 0 && [lsearch -exact $allHTMLattrs "$attr="] >= 0} {
  443.                 lappend specColor "${element}=$attr"
  444.             }
  445.             return [list "$attr=" $type]
  446.         }
  447.         Window {
  448.             if {[lsearch -exact $htmlWindowAttr "$attr="] < 0 && [lsearch -exact $allHTMLattrs "$attr="] >= 0} {
  449.                 lappend specWindow "${element}=$attr"
  450.             }
  451.             return [list "$attr=" $type]
  452.         }
  453.         "Event handler" {
  454.             return [list "$attr=" $type]
  455.         }
  456.     }
  457.     
  458. }
  459.  
  460. proc htmlSetCustProc1 {values elemType element} {
  461.     set box "-t {Layout} 80 10 180 25 ¥
  462.     -c {Always a new line before tag.} [lindex $values 0] 10 40 225 55 ¥
  463.     -c {Always a new line after tag.} [lindex $values 1] 10 60 225 75 ¥
  464.     -b OK 20 90 85 110 -b Cancel 105 90 170 110"
  465.     set values [eval [concat dialog -w 230 -h 120 $box]]
  466.     if {[lindex $values 3]} {return}
  467.     switch $elemType {
  468.         normal {set  customproc "htmlBuildOpening $element"}
  469.         input {set customproc "htmlBuildInputElem $element"}
  470.         plugin {set customproc "htmlBuildOpening EMBED"}
  471.     }
  472.     lappend customproc [lindex $values 0] [lindex $values 1]
  473.     if {$elemType == "plugin"} {lappend customproc $element}
  474.     return $customproc
  475. }
  476.  
  477. proc htmlSetCustProc2 {values element} {
  478.     set box "-t {Layout} 80 10 180 25 ¥
  479.     -r {text<TAG>text</TAG>text} [lindex $values 0] 10 40 200 60 ¥
  480.     -r {text¥r<TAG>text</TAG>¥rtext} [lindex $values 1] 10 70 150 130 ¥
  481.     -r {blank line¥r<TAG>text</TAG>¥rblank line} [lindex $values 2] 10 140 150 200 ¥
  482.     -r {blank line¥r<TAG>¥rtext¥r</TAG>¥rblank line} [lindex $values 3] 10 210 150 310"
  483.     set values [eval [concat dialog -w 200 -h 350 ¥
  484.     -b OK 20 320 85 340 -b Cancel 105 320 170 340 $box]]
  485.     if {[lindex $values 1]} {return}
  486.     if {[lindex $values 2]} {set customproc "htmlBuildElem $element"}
  487.     if {[lindex $values 3]} {set customproc "htmlBuildCRElem $element"}
  488.     if {[lindex $values 4]} {set customproc "htmlBuildCRElem $element 1"}
  489.     if {[lindex $values 5]} {set customproc "htmlBuildCR2Elem $element"}
  490.     return $customproc
  491. }
  492.  
  493. # Add new attributes to an element.
  494. proc htmlCustomNewAttr {} {
  495.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr
  496.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  497.     global htmlElemEventHandler1 HTMLmodeVars htmlSpecURL htmlSpecColor htmlSpecWindow
  498.     global specURL specColor specWindow htmlVersion
  499.     
  500.     if {[catch {listpick -p "Select element to add attributes to." ¥
  501.     [lsort [array names htmlElemAttrOptional1]]} element] || ¥
  502.     ![string length $element]} {return}
  503.     set allattrs {}
  504.     foreach e [htmlGetRequired $element] {
  505.         lappend allattrs [string trimright $e =]
  506.     }
  507.     foreach e [htmlGetOptional $element] {
  508.         lappend allattrs [string trimright $e =]
  509.     } 
  510.     if {[info exists htmlElemEventHandler1($element)]} {
  511.         foreach e $htmlElemEventHandler1($element) {
  512.             lappend allattrs [string trimright $e =]
  513.         }
  514.     }
  515.     set attributes [htmlGetCustomAttrs $element $allattrs 0]
  516.     if {![string length [join $attributes ""]]} {return}
  517.     set AttrOptional [lindex $attributes 0]
  518.     set AttrRequired [lindex $attributes 1]
  519.     set AttrNumber [lindex $attributes 2]
  520.     set AttrChoices [lindex $attributes 3]
  521.     set EventHandler [lindex $attributes 4]
  522.     set URL [lindex $attributes 5]
  523.     set Color [lindex $attributes 6]
  524.     set Window [lindex $attributes 7]
  525.     
  526.     if {[regexp { } $element]} {
  527.         set arg "¥[list $element¥]"
  528.     } else {
  529.         set arg $element
  530.     }
  531.     
  532.     if {![llength [htmlGetOptional $element]]} {
  533.         set rmenu 1
  534.     } else {
  535.         set rmenu 0
  536.     }
  537.     # Save the element
  538.     message "Saving new attributesﾉ"
  539.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  540.     set fid [open $PREFS:HTMLadditions.tcl a+]
  541.     if {!$isfile} {puts $fid $htmlVersion}
  542.     foreach rcne [list AttrRequired AttrChoices AttrNumber EventHandler AttrOptional] {
  543.         if {[string length [set $rcne]]} {
  544.             puts $fid "[list $element] ¥{lappend htmlElem${rcne}1($arg) [set $rcne]¥}"
  545.             append htmlElem${rcne}1($element) " " [set $rcne]
  546.         }
  547.     }
  548.     foreach ucw [list URL Color Window] {
  549.         if {[string length [set $ucw]]} {
  550.             foreach a [set $ucw] {
  551.                 puts $fid "[list $element] ¥{lappend html${ucw}Attr $a¥}"
  552.                 lappend html${ucw}Attr $a
  553.             }
  554.         }
  555.     }
  556.     foreach ucw [list URL Color Window] {
  557.         if {[llength [set spec$ucw]]} {
  558.             puts $fid "[list $element] ¥{lappend htmlSpec$ucw [set spec$ucw]¥}"
  559.             append htmlSpec$ucw " " [set spec$ucw]
  560.         }
  561.     }
  562.     close $fid
  563.     if {$rmenu} {htmlBuildMenu}
  564.     if {$HTMLmodeVars(JavaScriptColoring)} {
  565.         regModeKeywords -a -k $HTMLmodeVars(tagColor) ¥
  566.         HTML [concat $AttrRequired $AttrOptional]    
  567.     }
  568.     unset specURL
  569.     unset specColor
  570.     unset specWindow
  571.     message "Done."
  572.     if {!$HTMLmodeVars(useBigWindows) && [llength [htmlGetOptional $element]]} {htmlUseAttrs $element}
  573. }
  574.  
  575. # Add new choices to an attribute with predefined choices.
  576. proc htmlCustomNewChoice {} {
  577.     global htmlElemAttrChoices1 PREFS htmlVersion
  578.     if {[catch {listpick -p "Select element to add choices to." ¥
  579.     [lsort [array names htmlElemAttrChoices1]]} element] || ¥
  580.     ![string length $element]} {return}
  581.     set choiceatts ""
  582.     foreach e $htmlElemAttrChoices1($element) {
  583.         regexp {[^=]*} $e attr
  584.         if {[lsearch $choiceatts $attr] < 0} {lappend choiceatts $attr}
  585.     }
  586.     if {[catch {listpick -p "Select attribute to add choices to." [lsort $choiceatts]} attr] || ¥
  587.     ![string length $attr]} {return}
  588.     foreach c $htmlElemAttrChoices1($element) {
  589.         if {[string match "${attr}=*" $c]} {
  590.             lappend allchoices [string range $c [expr [string length $attr] + 1] end]
  591.         }    
  592.     }
  593.     
  594.     set newchoices [htmlCustomAttrFix $element $attr Choices [htmlGetAllAttrs] $allchoices]
  595.     foreach c [lindex $newchoices 2] {
  596.         lappend choices "${attr}=$c"
  597.     }
  598.     
  599.     if {[regexp { } $element]} {
  600.         set arg "¥[list $element¥]"
  601.     } else {
  602.         set arg $element
  603.     }
  604.     # Save the choices
  605.     message "Saving new choicesﾉ"
  606.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  607.     set fid [open $PREFS:HTMLadditions.tcl a+]
  608.     if {!$isfile} {puts $fid $htmlVersion}
  609.     puts $fid "[list $element] ¥{lappend htmlElemAttrChoices1($arg) $choices¥}"
  610.     append htmlElemAttrChoices1($element) " " $choices
  611.     close $fid
  612. }
  613.  
  614. #
  615. # Change key binding for a custom element.
  616. #
  617. proc htmlCustomChangeKey {} {
  618.     global htmlElemKeyBinding PREFS
  619.     if {![info exists htmlElemKeyBinding]} {
  620.         alertnote "No custom elements are defined."
  621.         return
  622.     }
  623.     if {[catch {listpick -p "Select element to change key binding for." ¥
  624.     [lsort [array names htmlElemKeyBinding]]} elem] || ![string length $elem]} {return}
  625.     set keystr $htmlElemKeyBinding($elem)
  626.     if {[string length $keystr]} {
  627.         set values "0 0 [string range $keystr [expr [string length $keystr] - 1] end]"
  628.         set keystr [string range $keystr 0 [expr [string length $keystr] - 3]]
  629.         lappend values [regexp {U} $keystr]
  630.         lappend values [regexp {B} $keystr]
  631.         lappend values [regexp {I} $keystr]
  632.         lappend values [regexp {O} $keystr]
  633.     } else {
  634.         set values {0 0 {} 0 0 0 0}
  635.     }
  636.     while {1} {
  637.         set box "-t {Key binding for $elem} 40 10 290 25 ¥
  638.         -t Key 10 40 40 55 -e [list [lindex $values 2]] 50 40 70 55 ¥
  639.         -c Shift [lindex $values 3] 10 60 60 75 ¥
  640.         -c Control [lindex $values 4] 80 60 150 75 ¥
  641.         -c Option [lindex $values 5] 160 60 220 75 ¥
  642.         -c Command [lindex $values 6] 230 60 315 75"
  643.         set values [eval [concat dialog -w 320 -h 120 ¥
  644.         -b OK 20 90 85 110 -b Cancel 105 90 170 110 $box]]
  645.         if {[lindex $values 1]} {return}
  646.         set elemKey [string toupper [string trim [lindex $values 2]]]
  647.         set keyStr ""
  648.         if {[lindex $values 3]} {append keyStr "<U"}
  649.         if {[lindex $values 4]} {append keyStr "<B"}
  650.         if {[lindex $values 5]} {append keyStr "<I"}
  651.         if {[lindex $values 6]} {append keyStr "<O"}
  652.         if {[string length $elemKey] > 1} {
  653.             alertnote "You should only give one character for key binding."
  654.         } elseif {[string length $elemKey] && ($keyStr == "" || $keyStr == "<U")} {
  655.             alertnote "You must choose at least one of the modifiers control, option and command when you define a key binding."
  656.         } else {
  657.             break
  658.         }
  659.     }
  660.     if {![string length $elemKey]} {
  661.         set keyStr ""
  662.     } else {
  663.         set elemKey "/$elemKey"
  664.     }    
  665.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  666.         alertnote "Cannot find 'HTMLadditions.tcl'. Key binding cannot be changed."
  667.         return
  668.     }
  669.     message "Redefining key bindingﾉ"
  670.     set fid [open $PREFS:HTMLadditions.tcl r]
  671.     set filecont [string trimright [read $fid] "¥n"]
  672.     close $fid
  673.     foreach line [split $filecont "¥n"] {
  674.         if {[lindex $line 0] == $elem && [regexp {htmlElemKeyBinding} $line]} {
  675.             append newlines "$elem ¥{set htmlElemKeyBinding($elem) [list $keyStr$elemKey]¥}¥n"
  676.         } else {
  677.             append newlines "$line¥n"
  678.         }
  679.     }
  680.     set fid [open $PREFS:HTMLadditions.tcl w]
  681.     puts -nonewline $fid $newlines
  682.     close $fid
  683.     set htmlElemKeyBinding($elem) $keyStr$elemKey
  684.     htmlBuildMenu
  685.     message "Done."
  686. }
  687.  
  688. #
  689. # Change type and layout for a custom element.
  690. #
  691. proc htmlCustomChangeType {} {
  692.     global htmlElemKeyBinding htmlElemProc PREFS htmlPlugins
  693.     if {![info exists htmlElemKeyBinding]} {
  694.         alertnote "No custom elements are defined."
  695.         return
  696.     }
  697.     if {[catch {listpick -p "Select element to change type and layout for." ¥
  698.     [lsort [array names htmlElemKeyBinding]]} elem] || ![string length $elem]} {return}
  699.     set eproc $htmlElemProc($elem)
  700.     set proctype [lindex $eproc 0]
  701.     if {$proctype == "htmlBuildOpening" || $proctype == "htmlBuildInputElem"} {
  702.         if {[lindex $eproc 1] == "EMBED"} {
  703.             set type plugin
  704.         } else {
  705.             set type normal
  706.         }
  707.         if {$proctype == "htmlBuildInputElem"} {set type input}
  708.         set closing 0
  709.         set values "[lindex $eproc 2] [lindex $eproc 3]"
  710.     } else {
  711.         set type normal
  712.         set closing 1
  713.         if {$proctype == "htmlBuildElem"} {set values {1 0 0 0}}
  714.         if {$proctype == "htmlBuildCRElem" && [llength $eproc] == 2} {set values {0 1 0 0}}
  715.         if {$proctype == "htmlBuildCRElem" && [llength $eproc] == 3} {set values {0 0 1 0}}
  716.         if {$proctype == "htmlBuildCR2Elem"} {set values {0 0 0 1}}
  717.     }
  718.     set box "-t $elem 100 10 300 25 ¥
  719.     -c {Has closing tag} $closing 10 40 150 55 ¥
  720.     -t {Element type} 10 80 100 95 -r Normal [regexp {normal} $type] 10 100 100 115 ¥
  721.     -r {INPUT element with TYPE given above} [regexp {input} $type] 10 120 300 135 ¥
  722.     -r {Plug-in} [regexp {plugin} $type] 10 140 100 155 ¥
  723.     -b OK 20 170 85 190 -b Cancel 105 170 170 190"
  724.     set typeval [eval [concat dialog -w 310 -h 200 $box]]
  725.     if {[lindex $typeval 5]} {return}
  726.     set newclosing [lindex $typeval 0]
  727.     if {[lindex $typeval 1]} {set newtype normal}
  728.     if {[lindex $typeval 2]} {set newtype input; set newclosing 0}
  729.     if {[lindex $typeval 3]} {set newtype plugin; set newclosing 0}
  730.  
  731.     if {$newclosing} {
  732.         if {$newclosing != $closing} {set values {1 0 0 0}}
  733.         set customproc [htmlSetCustProc2 $values $elem]
  734.     } else {
  735.         if {$newclosing != $closing} {set values {0 0}}
  736.         set customproc [htmlSetCustProc1 $values $newtype $elem]
  737.     }
  738.     if {![string length $customproc]} {return}
  739.     
  740.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  741.         alertnote "Cannot find 'HTMLadditions.tcl'. Type and layout cannot be changed."
  742.         return
  743.     }
  744.     message "Redefining type and layoutﾉ"
  745.     set fid [open $PREFS:HTMLadditions.tcl r]
  746.     set filecont [string trimright [read $fid] "¥n"]
  747.     close $fid
  748.     foreach line [split $filecont "¥n"] {
  749.         if {[lindex $line 0] == $elem && [regexp {htmlElemProc} $line]} {
  750.             append newlines "$elem ¥{set htmlElemProc($elem) [list $customproc]¥}¥n"
  751.         } elseif {$type == "plugin" && $newtype != "plugin" && [lindex $line 0] == $elem && ¥
  752.         [regexp {htmlPlugins} $line]} {
  753.             set where [lsearch -exact $htmlPlugins $elem]
  754.             set htmlPlugins [lreplace $htmlPlugins $where $where]
  755.         } else {
  756.             append newlines "$line¥n"
  757.         }
  758.     }
  759.     if {$newtype == "plugin" && $type != "plugin"} {
  760.         lappend htmlPlugins $elem
  761.         append newlines "$elem ¥{lappend htmlPlugins $elem¥}¥n"
  762.     }
  763.     set fid [open $PREFS:HTMLadditions.tcl w]
  764.     puts -nonewline $fid $newlines
  765.     close $fid
  766.     set htmlElemProc($elem) $customproc
  767.     message "Done."
  768. }
  769.  
  770. # Remove custom element ot additions to an element.
  771. proc htmlCustomRemove {} {
  772.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr
  773.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  774.     global htmlElemEventHandler1 htmlElemProc htmlElemKeyBinding htmlPlugins
  775.     global htmlSpecURL htmlSpecColor htmlSpecWindow htmlVersion
  776.     
  777.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  778.         if {[info exists htmlElemKeyBinding]} {
  779.             alertnote "Cannot find 'HTMLadditions.tcl'. Custom additions cannot be removed."
  780.         } else {
  781.             alertnote "No custom additions has been made."
  782.         }
  783.         return
  784.     }
  785.     set fid [open $PREFS:HTMLadditions.tcl r]
  786.     set additions [string trimright [read $fid] "¥n"]
  787.     close $fid
  788.     set elems ""
  789.     foreach line [lrange [split $additions "¥n"] 1 end] {
  790.         set element [lindex $line 0]
  791.         if {[lsearch -exact $elems $element] < 0} {lappend elems $element}
  792.     }
  793.     if {[catch {listpick -p "Select element to remove additions from." [lsort $elems]} element] || ¥
  794.     ![string length $element] || [askyesno "Remove additions from $element?"] == "no"} {return}
  795.     
  796.     # Perhaps rebuild menu for if old elem and no optional attrs after removal.  
  797.     if {[llength [htmlGetOptional $element]]} {
  798.         set rmenu 1
  799.     } else {
  800.         set rmenu 0
  801.     }
  802.  
  803.     message "Removing additions to $elementﾉ"
  804.     set isNewElem [info exists htmlElemKeyBinding($element)]
  805.     # If new element, unset all its variables.
  806.     if {$isNewElem} {
  807.         catch {unset htmlElemAttrRequired1($element)}
  808.         catch {unset htmlElemAttrChoices1($element)}
  809.         catch {unset htmlElemAttrNumber1($element)}
  810.         catch {unset htmlElemAttrOptional1($element)}
  811.         catch {unset htmlElemEventHandler1($element)}
  812.         set tmpkey $htmlElemKeyBinding($element)
  813.         catch {unset htmlElemKeyBinding($element)}
  814.         catch {unset htmlElemProc($element)}
  815.         set isPlugin [lsearch -exact $htmlPlugins $element]
  816.         if {$isPlugin >=0 } {set htmlPlugins [lreplace $htmlPlugins $isPlugin $isPlugin]}
  817.         if {![llength [array names htmlElemKeyBinding]]} {
  818.             catch {unset htmlElemKeyBinding}
  819.             if {[string length $tmpkey]} {
  820.                 set key [string tolower [string range $tmpkey [expr [string length $tmpkey] - 1] end]]
  821.                 set mods ""
  822.                 foreach m [split [string range $tmpkey 1 [expr [string length $tmpkey] - 3]] < ] {
  823.                     if {$m == "B"} {append mods z}
  824.                     if {$m == "I"} {append mods o}
  825.                     if {$m == "U"} {append mods s}
  826.                     if {$m == "O"} {append mods c}
  827.                 }
  828.                 catch {unbind '$key' <$mods> {} HTML}
  829.             }
  830.         }
  831.         if {![llength [array names htmlElemProc]]} {catch {unset htmlElemProc}}
  832.     }
  833.     set newlines ""
  834.     foreach line [lrange [split $additions "¥n"] 1 end] {
  835.         set command [lindex $line 1]
  836.         if {[lindex $line 0] != $element} {
  837.             append newlines "$line¥n"
  838.         } elseif {[lindex $command 0] == "lappend"} {
  839.             set var [lindex $command 1]
  840.             # Remove from URL, Color and Window lists.
  841.             foreach ucw [list URL Color Window] {
  842.                 if {$var == "html${ucw}Attr"} {
  843.                     lappend ${ucw}maybe [lindex $command 2]
  844.                     set where [lsearch -exact [set html${ucw}Attr] [lindex $command 2]]
  845.                     set html${ucw}Attr [lreplace [set html${ucw}Attr] $where $where]
  846.                 }
  847.                 if {$var == "htmlSpec${ucw}"} {
  848.                     foreach c [lrange $command 2 end] {
  849.                         set where [lsearch -exact [set htmlSpec${ucw}] $c]
  850.                         set htmlSpec${ucw} [lreplace [set htmlSpec${ucw}] $where $where]
  851.                     }
  852.                 }
  853.             } 
  854.             # If added attribute to old element, remove attribute
  855.             if {!$isNewElem && $var != "htmlURLAttr" && $var != "htmlColorAttr" && ¥
  856.             $var != "htmlWindowAttr" && $var != "htmlSpecURL" && $var != "htmlSpecColor" && ¥
  857.             $var != "htmlSpecWindow"} {
  858.                 regexp {([^¥(]+)¥(([^¥)]+)¥)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  859.                 foreach c $added {
  860.                     set where [lsearch -exact [set ${var}($element)] $c]
  861.                     set ${var}($element) [lreplace [set ${var}($element)] $where $where]
  862.                 }
  863.             }
  864.         }
  865.     }
  866.     # Unset empty lists for old variables.
  867.     if {!$isNewElem} {
  868.         foreach c [list AttrRequired AttrChoices AttrNumber EventHandler] {
  869.             if {[info exists html${c}1($element)] && ![llength html${c}1($element)]} {
  870.                 unset html${c}1($element)
  871.             }
  872.         }
  873.     }
  874.     # URL, Color or Window attributes just removed
  875.     # should be replaced if they are used by some other element.
  876.     foreach ucw [list URL Color Window] {
  877.         if {[info exists ${ucw}maybe]} {
  878.             append newlines [htmlUCWmaybe $ucw [set ${ucw}maybe]]
  879.         }
  880.     }
  881.     if {[string length $newlines]} {
  882.         set fid [open $PREFS:HTMLadditions.tcl w]
  883.         puts -nonewline $fid "$htmlVersion¥n$newlines"
  884.         close $fid
  885.     } else {
  886.         removeFile $PREFS:HTMLadditions.tcl
  887.     }
  888.     if {$isNewElem || ($rmenu && ![llength [htmlGetOptional $element]])} {htmlBuildMenu}
  889.     message "Done."
  890. }
  891.  
  892. proc htmlUCWmaybe {ucw maybe} {
  893.     global htmlElemAttrRequired1 htmlElemAttrOptional1 htmlSpecURL htmlSpecColor htmlSpecWindow
  894.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  895.     
  896.     set newlines ""
  897.     foreach m $maybe {
  898.         set foundit 0
  899.         foreach e [array names htmlElemAttrRequired1] {
  900.             if {[lsearch -exact $htmlElemAttrRequired1($e) $m] >= 0 && ¥
  901.             [lsearch -exact [set htmlSpec$ucw] "$e!=[string trimright $m =]"] < 0} {
  902.                 append newlines "[list $e] ¥{lappend html${ucw}Attr $m¥}¥n"
  903.                 lappend html${ucw}Attr $m
  904.                 set foundit 1
  905.                 break
  906.             } 
  907.         }
  908.         if {$foundit} {continue}
  909.         foreach e [array names htmlElemAttrOptional1] {
  910.             if {[lsearch -exact $htmlElemAttrOptional1($e) $m] >= 0 && ¥
  911.             [lsearch -exact [set htmlSpec$ucw] "$e!=[string trimright $m =]"] < 0} {
  912.                 append newlines "[list $e] ¥{lappend html${ucw}Attr $m¥}¥n"
  913.                 lappend html${ucw}Attr $m
  914.                 break
  915.             } 
  916.         }
  917.     }
  918.     return $newlines
  919. }
  920.  
  921. # Remove custom element ot additions to an element.
  922. proc htmlCustomRemoveAttrs {} {
  923.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr
  924.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  925.     global htmlElemEventHandler1
  926.     global htmlSpecURL htmlSpecColor htmlSpecWindow htmlVersion
  927.     
  928.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  929.         if {[info exists htmlElemKeyBinding]} {
  930.             alertnote "Cannot find 'HTMLadditions.tcl'. Custom additions cannot be removed."
  931.         } else {
  932.             alertnote "No custom additions has been made."
  933.         }
  934.         return
  935.     }
  936.     set fid [open $PREFS:HTMLadditions.tcl r]
  937.     set additions [string trimright [read $fid] "¥n"]
  938.     close $fid
  939.     set elems ""
  940.     foreach line [lrange [split $additions "¥n"] 1 end] {
  941.         set element [lindex $line 0]
  942.         if {[lsearch -exact $elems $element] < 0 && ¥
  943.         ([llength [concat [htmlGetRequired $element] [htmlGetOptional $element]]] || ¥
  944.         [info exists htmlElemEventHandler1($element)])} {
  945.             lappend elems $element
  946.         }
  947.     }
  948.     if {[catch {listpick -p "Select element to remove attributes from." [lsort $elems]} element] || ¥
  949.     ![string length $element]} {return}
  950.     
  951.     set allatts {}
  952.     foreach line [lrange [split $additions "¥n"] 1 end] {
  953.         set command [lindex $line 1]
  954.         if {[lindex $line 0] == $element} {
  955.             regexp {([^¥(]+)¥(([^¥)]+)¥)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  956.             set added [string trimleft [string trimright $added ¥}] ¥{]
  957.             if {$var == "htmlElemAttrRequired1" || $var == "htmlElemAttrOptional1" || $var == "htmlElemEventHandler1"} {
  958.                 foreach c $added {
  959.                     if {[lsearch -exact $allatts [string trimright $c =]] < 0} {
  960.                         lappend allatts [string trimright $c =]
  961.                     }
  962.                 }
  963.             } elseif {$var == "htmlElemAttrChoices1"} {
  964.                 foreach c $added {
  965.                     regexp {[^=]+} $c tmp
  966.                     if {[lsearch -exact $allatts $tmp] < 0} {
  967.                         lappend allatts $tmp
  968.                     }
  969.                 }
  970.             }
  971.         }
  972.     }
  973.     
  974.     if {[catch {listpick -p "Select attributes to remove." -l [lsort $allatts]} attrs] || ¥
  975.     ![string length $attrs]} {return}
  976.             
  977.     # Perhaps rebuild menu for if old elem and no optional attrs after removal.  
  978.     if {[llength [htmlGetOptional $element]]} {
  979.         set rmenu 1
  980.     } else {
  981.         set rmenu 0
  982.     }
  983.  
  984.     message "Removing attributes from $elementﾉ"
  985.     set newlines ""
  986.     foreach line [lrange [split $additions "¥n"] 1 end] {
  987.         set command [lindex $line 1]
  988.         if {[lindex $line 0] != $element} {
  989.             append newlines "$line¥n"
  990.         } else {
  991.             set var [lindex $command 1]
  992.             # Remove from URL, Color and Window lists.
  993.             foreach ucw [list URL Color Window] {
  994.                 if {$var == "html${ucw}Attr"} {
  995.                     if {[lsearch -exact $attrs [string trimright [lindex $command 2] =]] >= 0} {
  996.                         lappend ${ucw}maybe [lindex $command 2]
  997.                         set where [lsearch -exact [set html${ucw}Attr] [lindex $command 2]]
  998.                         set html${ucw}Attr [lreplace [set html${ucw}Attr] $where $where]
  999.                     } else {
  1000.                         append newlines "$line¥n"
  1001.                     }
  1002.                 }
  1003.                 if {$var == "htmlSpec${ucw}"} {
  1004.                     set tmpadd [lrange $command 2 end]
  1005.                     foreach c $tmpadd {
  1006.                         regexp {[^!=]+!?=(.*)} $c dum tmp
  1007.                         if {[lsearch -exact $attrs $tmp] >= 0} {
  1008.                             set where [lsearch -exact [set htmlSpec${ucw}] $c]
  1009.                             set htmlSpec${ucw} [lreplace [set htmlSpec${ucw}] $where $where]
  1010.                             set where [lsearch -exact $tmpadd $c]
  1011.                             set tmpadd [lreplace $tmpadd $where $where]
  1012.                         }
  1013.                     }
  1014.                     if {[llength $tmpadd]} {append newlines "[list $element] ¥{lappend htmlSpec${ucw} $tmpadd¥}¥n"} 
  1015.                 }
  1016.             } 
  1017.             if {[lsearch {htmlURLAttr htmlColorAttr htmlWindowAttr htmlSpecURL htmlSpecColor htmlSpecWindow htmlPlugins} $var] < 0 && ¥
  1018.             ![string match "htmlElemKeyBinding*" $var] && ![string match "htmlElemProc*" $var]} {
  1019.                 regexp {([^¥(]+)¥(([^¥)]+)¥)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  1020.                 set added [string trimleft [string trimright $added ¥}] ¥{]
  1021.                 foreach c $added {
  1022.                     regexp {[^=]+} $c tmp
  1023.                     if {[lsearch -exact $attrs $tmp] >= 0} {
  1024.                         set where [lsearch -exact [set ${var}($element)] $c]
  1025.                         set ${var}($element) [lreplace [set ${var}($element)] $where $where]
  1026.                         set where [lsearch -exact $added $c]
  1027.                         set added [lreplace $added $where $where]
  1028.                     }
  1029.                 }
  1030.                 if {[llength $added] || ([lindex $command 0] == "set" && $var == "htmlElemAttrOptional1")} {
  1031.                     if {[lindex $command 0] == "set"} {set added [list $added]}
  1032.                     append newlines "[list $element] ¥{[lindex $command 0] ${var}($arg) $added¥}¥n"
  1033.                 }
  1034.             }
  1035.             if {[string match "htmlElemKeyBinding*" $var] || [string match "htmlElemProc*" $var]} {
  1036.                 append newlines "$line¥n"
  1037.             }
  1038.         }
  1039.     }
  1040.     # Unset empty lists.
  1041.     foreach c [list AttrRequired AttrChoices AttrNumber EventHandler] {
  1042.         if {[info exists html${c}1($element)] && ![llength html${c}1($element)]} {
  1043.             unset html${c}1($element)
  1044.         }
  1045.     }
  1046.     # URL, Color or Window attributes just removed
  1047.     # should be replaced if they are used by some other element.
  1048.     foreach ucw [list URL Color Window] {
  1049.         if {[info exists ${ucw}maybe]} {
  1050.             append newlines [htmlUCWmaybe $ucw [set ${ucw}maybe]]
  1051.         }
  1052.     }
  1053.     if {[string length $newlines]} {
  1054.         set fid [open $PREFS:HTMLadditions.tcl w]
  1055.         puts -nonewline $fid "$htmlVersion¥n$newlines"
  1056.         close $fid
  1057.     } else {
  1058.         removeFile $PREFS:HTMLadditions.tcl
  1059.     }
  1060.     if {$rmenu && ![llength [htmlGetOptional $element]]} {htmlBuildMenu}
  1061.     message "Done."
  1062. }
  1063.  
  1064.